home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / online / source / c / compilers / Bob 1.5.sit.hqx / Bob 1.5 / Bobint.c < prev    next >
Text File  |  1991-10-01  |  12KB  |  586 lines
  1. /* bobint.c - bytecode interpreter */
  2. /*
  3.     Copyright (c) 1991, by David Michael Betz
  4.     All rights reserved
  5. */
  6.  
  7. #include <setjmp.h>
  8. #include "bob.h"
  9.  
  10. #define iszero(x)    ((x)->v_type == DT_INTEGER && (x)->v.v_integer == 0)
  11. #define istrue(x)    ((x)->v_type != DT_NIL && !iszero(x))
  12.  
  13. /* global variables */
  14. unsigned char *cbase;    /* the base code address */
  15. unsigned char *pc;    /* the program counter */
  16. VECTOR *code;        /* the current code vector */
  17. VALUE *stkbase;        /* the runtime stack */
  18. VALUE *stktop;        /* the top of the stack */
  19. VALUE *sp;        /* the stack pointer */
  20. VALUE *fp;        /* the frame pointer */
  21. int trace=0;        /* variable to control tracing */
  22.  
  23. /* external variables */
  24. extern VALUE symbols;
  25. extern jmp_buf error_trap;
  26.  
  27. /* forward declarations */
  28. #ifdef __STDC__
  29. static void interpret(int);
  30. static void opCALL(void);
  31. static int opRETURN(void);
  32. static void opSEND(void);
  33. static void opVREF(void);
  34. static void opVSET(void);
  35. static void opADD(void);
  36. static int getwoperand(void);
  37. static char *typename(int type);
  38. #else
  39. char *typename();
  40. #endif
  41.  
  42. /* execute - execute a bytecode function */
  43. int execute(name)
  44.   char *name;
  45. {
  46.     if (setjmp(error_trap) != 0)
  47.     return (FALSE);
  48.     if (!start_call(name))
  49.     return (FALSE);
  50.     return (execute_call(0));
  51. }
  52.  
  53. /* start_call - start a function call */
  54. int start_call(name)
  55.   char *name;
  56. {
  57.     DICT_ENTRY *sym;
  58.     
  59.     /* lookup the symbol */
  60.     if ((sym = findentry(&symbols,name)) == NULL)
  61.     return (FALSE);
  62.  
  63.     /* setup the stack */
  64.     sp = fp = stktop;
  65.     *--sp = sym->de_value;
  66.     return (TRUE);
  67. }
  68.  
  69. /* start_send - start a message send */
  70. int start_send(obj,selector)
  71.   OBJECT *obj; char *selector;
  72. {
  73.     sp = fp = stktop;
  74.     push_object(obj);
  75.     push_string(makestring(selector));
  76.     return (TRUE);
  77. }
  78.  
  79. /* execute_call - execute a function call */
  80. int execute_call(n)
  81.   int n;
  82. {
  83.     switch (sp[n].v_type) {
  84.     case DT_CODE:
  85.     (*sp[n].v.v_code)(n);
  86.     return (TRUE);
  87.     case DT_BYTECODE:
  88.     interpret(n);
  89.     return (TRUE);
  90.     }
  91.     return (FALSE);
  92. }
  93.  
  94. /* interpret - interpret bytecode instructions */
  95. static void interpret(argc)
  96.   int argc;
  97. {
  98.     register OBJECT *obj;
  99.     register int n;
  100.     
  101.     /* make a dummy call frame */
  102.     check(3);
  103.     code = sp[argc].v.v_vector;
  104.     push_integer(argc);        /* argument count */
  105.     push_integer(stktop - fp);    /* old fp */
  106.     push_integer(0);        /* old pc */
  107.     cbase = pc = code->vec_data[0].v.v_string->str_data;
  108.     fp = sp;
  109.     
  110.     /* execute each instruction */
  111.     for (;;) {
  112.     if (trace) {
  113.         check(1);
  114.         push_bytecode(code);
  115.         decode_instruction(sp,pc-strgetdata(vecgetelement(sp,0)));
  116.         ++sp;
  117.     }
  118.     switch (*pc++) {
  119.     case OP_CALL:    opCALL();    break;
  120.     case OP_RETURN: if (!opRETURN()) return;
  121.             break;
  122.     case OP_SEND:    opSEND();    break;
  123.     case OP_ADD:    opADD();    break;
  124.     case OP_VREF:    opVREF();    break;
  125.     case OP_VSET:    opVSET();    break;
  126.     case OP_REF:
  127.         *sp = code->vec_data[*pc++].v.v_var->de_value;
  128.         break;
  129.     case OP_SET:
  130.         code->vec_data[*pc++].v.v_var->de_value = *sp;
  131.         break;
  132.     case OP_MREF:
  133.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  134.         *sp = obj->obj_members[*pc++];
  135.         break;
  136.     case OP_MSET:
  137.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  138.         obj->obj_members[*pc++] = *sp;
  139.         break;
  140.     case OP_AREF:
  141.         n = *pc++;
  142.         if (n >= fp[2].v.v_integer)
  143.             error("Too few arguments");
  144.         *sp = fp[n+3];
  145.         break;
  146.     case OP_ASET:
  147.         n = *pc++;
  148.         if (n >= fp[2].v.v_integer)
  149.             error("Too few arguments");
  150.         fp[n+3] = *sp;
  151.         break;
  152.     case OP_TREF:
  153.         n = *pc++;
  154.         *sp = fp[-n-1];
  155.         break;
  156.     case OP_TSET:
  157.         n = *pc++;
  158.         fp[-n-1] = *sp;
  159.         break;
  160.     case OP_TSPACE:
  161.         n = *pc++;
  162.         check(n);
  163.         while (--n >= 0) {
  164.             --sp;
  165.             set_nil(sp);
  166.         }
  167.         break;
  168.     case OP_BRT:
  169.         if (istrue(sp))
  170.             pc = cbase + getwoperand();
  171.         else
  172.             pc += 2;
  173.         break;
  174.     case OP_BRF:
  175.         if (istrue(sp))
  176.             pc += 2;
  177.         else
  178.             pc = cbase + getwoperand();
  179.         break;
  180.     case OP_BR:
  181.         pc = cbase + getwoperand();
  182.         break;
  183.     case OP_NIL:
  184.         set_nil(sp);
  185.         break;
  186.     case OP_PUSH:
  187.         check(1);
  188.         push_integer(FALSE);
  189.         break;
  190.     case OP_NOT:
  191.         if (istrue(sp))
  192.             set_integer(sp,FALSE);
  193.         else
  194.             set_integer(sp,TRUE);
  195.         break;
  196.     case OP_NEG:
  197.         chktype(0,DT_INTEGER);
  198.         sp->v.v_integer = -sp->v.v_integer;
  199.         break;
  200.     case OP_SUB:
  201.         chktype(0,DT_INTEGER);
  202.         chktype(1,DT_INTEGER);
  203.         sp[1].v.v_integer -= sp->v.v_integer;
  204.         ++sp;
  205.         break;
  206.     case OP_MUL:
  207.         chktype(0,DT_INTEGER);
  208.         chktype(1,DT_INTEGER);
  209.         sp[1].v.v_integer *= sp->v.v_integer;
  210.         ++sp;
  211.         break;
  212.     case OP_DIV:
  213.         chktype(0,DT_INTEGER);
  214.         chktype(1,DT_INTEGER);
  215.         if (sp->v.v_integer != 0) {
  216.             int x=sp->v.v_integer;
  217.             sp[1].v.v_integer /= x;
  218.         }
  219.         else
  220.             sp[1].v.v_integer = 0;
  221.         ++sp;
  222.         break;
  223.     case OP_REM:
  224.         chktype(0,DT_INTEGER);
  225.         chktype(1,DT_INTEGER);
  226.         if (sp->v.v_integer != 0) {
  227.             int x=sp->v.v_integer;
  228.             sp[1].v.v_integer %= x;
  229.         }
  230.         else
  231.             sp[1].v.v_integer = 0;
  232.         ++sp;
  233.         break;
  234.     case OP_INC:
  235.         chktype(0,DT_INTEGER);
  236.         ++sp->v.v_integer;
  237.         break;
  238.     case OP_DEC:
  239.         chktype(0,DT_INTEGER);
  240.         --sp->v.v_integer;
  241.         break;
  242.     case OP_BAND:
  243.         chktype(0,DT_INTEGER);
  244.         chktype(1,DT_INTEGER);
  245.         sp[1].v.v_integer &= sp->v.v_integer;
  246.         ++sp;
  247.         break;
  248.     case OP_BOR:
  249.         chktype(0,DT_INTEGER);
  250.         chktype(1,DT_INTEGER);
  251.         sp[1].v.v_integer |= sp->v.v_integer;
  252.         ++sp;
  253.         break;
  254.     case OP_XOR:
  255.         chktype(0,DT_INTEGER);
  256.         chktype(1,DT_INTEGER);
  257.         sp[1].v.v_integer ^= sp->v.v_integer;
  258.         ++sp;
  259.         break;
  260.     case OP_BNOT:
  261.         chktype(0,DT_INTEGER);
  262.         sp->v.v_integer = ~sp->v.v_integer;
  263.         break;
  264.     case OP_SHL:
  265.         switch (sp[1].v_type) {
  266.         case DT_INTEGER:
  267.             chktype(0,DT_INTEGER);
  268.             sp[1].v.v_integer <<= sp->v.v_integer;
  269.             break;
  270.         case DT_IOSTREAM:
  271.             print1(&sp[1],FALSE,&sp[0]);
  272.             break;
  273.         default:
  274.             break;
  275.         }
  276.         ++sp;
  277.         break;
  278.     case OP_SHR:
  279.         chktype(0,DT_INTEGER);
  280.         chktype(1,DT_INTEGER);
  281.         sp[1].v.v_integer >>= sp->v.v_integer;
  282.         ++sp;
  283.         break;
  284.     case OP_LT:
  285.         chktype(0,DT_INTEGER);
  286.         chktype(1,DT_INTEGER);
  287.         n = sp[1].v.v_integer < sp->v.v_integer;
  288.         ++sp;
  289.         set_integer(sp,n ? TRUE : FALSE);
  290.         break;
  291.     case OP_LE:
  292.         chktype(0,DT_INTEGER);
  293.         chktype(1,DT_INTEGER);
  294.         n = sp[1].v.v_integer <= sp->v.v_integer;
  295.         ++sp;
  296.         set_integer(sp,n ? TRUE : FALSE);
  297.         break;
  298.     case OP_EQ:
  299.         chktype(0,DT_INTEGER);
  300.         chktype(1,DT_INTEGER);
  301.         n = sp[1].v.v_integer == sp->v.v_integer;
  302.         ++sp;
  303.         set_integer(sp,n ? TRUE : FALSE);
  304.         break;
  305.     case OP_NE:
  306.         chktype(0,DT_INTEGER);
  307.         chktype(1,DT_INTEGER);
  308.         n = sp[1].v.v_integer != sp->v.v_integer;
  309.         ++sp;
  310.         set_integer(sp,n ? TRUE : FALSE);
  311.         break;
  312.     case OP_GE:
  313.         chktype(0,DT_INTEGER);
  314.         chktype(1,DT_INTEGER);
  315.         n = sp[1].v.v_integer >= sp->v.v_integer;
  316.         ++sp;
  317.         set_integer(sp,n ? TRUE : FALSE);
  318.         break;
  319.     case OP_GT:
  320.         chktype(0,DT_INTEGER);
  321.         chktype(1,DT_INTEGER);
  322.         n = sp[1].v.v_integer > sp->v.v_integer;
  323.         ++sp;
  324.         set_integer(sp,n ? TRUE : FALSE);
  325.         break;
  326.     case OP_LIT:
  327.         *sp = code->vec_data[*pc++];
  328.         break;
  329.     case OP_DUP2:
  330.         check(2);
  331.         sp -= 2;
  332.         *sp = sp[2];
  333.         sp[1] = sp[3];
  334.         break;
  335.     case OP_NEW:
  336.         chktype(0,DT_CLASS);
  337.         set_object(sp,newobject(sp));
  338.         break;
  339.     default:
  340.         error("Bad opcode %02x",pc[-1]);
  341.         break;
  342.     }
  343.     }
  344. }
  345.  
  346. /* opCALL - CALL opcode handler */
  347. static void opCALL()
  348. {
  349.     register int n;
  350.     n = *pc++;    /* get argument count */
  351.     switch (sp[n].v_type) {
  352.     case DT_CODE:
  353.         (*sp[n].v.v_code)(n);
  354.         break;
  355.     case DT_BYTECODE:
  356.         check(3);
  357.         code = sp[n].v.v_vector;
  358.         push_integer(n);        /* argument count */
  359.         push_integer(stktop - fp);    /* old fp */
  360.         push_integer(pc - cbase);    /* old pc */
  361.         cbase = pc = code->vec_data[0].v.v_string->str_data;
  362.         fp = sp;
  363.         break;
  364.     default:
  365.         error("Call to non-procedure, Type %s",typename(sp[n].v_type));
  366.     break;
  367.     }
  368. }
  369.  
  370. /* opRETURN - RETURN opcode handler */
  371. static int opRETURN()
  372. {
  373.     register int pcoff,n;
  374.     VALUE val;
  375.     val = *sp;
  376.     sp = fp;
  377.     pcoff = fp[0].v.v_integer;
  378.     n = fp[2].v.v_integer;
  379.     fp = stktop - fp[1].v.v_integer;
  380.     if (fp == stktop) return (FALSE);
  381.     code = fp[fp[2].v.v_integer+3].v.v_vector;
  382.     cbase = code->vec_data[0].v.v_string->str_data;
  383.     pc = cbase + pcoff;
  384.     sp += n + 3;
  385.     *sp = val;
  386.     return (TRUE);
  387. }
  388.  
  389. /* opSEND - SEND opcode handler */
  390. static void opSEND()
  391. {
  392.     register int n;
  393.     char selector[TKNSIZE+1];
  394.     DICT_ENTRY *de;
  395.     VALUE *class;
  396.     n = *pc++;
  397.     chktype(n,DT_OBJECT);
  398.     chktype(n-1,DT_STRING);
  399.     class = objgetclass(&sp[n]);
  400.     getcstring(selector,sizeof(selector),&sp[n-1]);
  401.     sp[n-1] = sp[n];
  402.     do {
  403.     if ((de = findentry(clgetfunctions(class),selector)) != NULL) {
  404.         switch (de->de_value.v_type) {
  405.         case DT_CODE:
  406.         (*de->de_value.v.v_code)(n);
  407.         return;
  408.         case DT_BYTECODE:
  409.         check(3);
  410.         code = de->de_value.v.v_vector;
  411.         set_bytecode(&sp[n],code);
  412.         push_integer(n);        /* argument count */
  413.         push_integer(stktop - fp);    /* old fp */
  414.         push_integer(pc - cbase);    /* old pc */
  415.         cbase = pc = code->vec_data[0].v.v_string->str_data;
  416.         fp = sp;
  417.         return;
  418.         default:
  419.         error("Bad method, Selector '%s', Type %d",
  420.               selector,
  421.               de->de_value.v_type);
  422.         }
  423.     }
  424.     class = clgetbase(class);
  425.     } while (!isnil(class));
  426.     error("No method for selector '%s'",selector);
  427. }
  428.  
  429. /* opVREF - VREF opcode handler */
  430. static void opVREF()
  431. {
  432.     VECTOR *vect;
  433.     STRING *str;
  434.     int i;
  435.     chktype(0,DT_INTEGER);
  436.     switch (sp[1].v_type) {
  437.     case DT_VECTOR:
  438.     vect = sp[1].v.v_vector;
  439.     i = sp[0].v.v_integer;
  440.     if (i < 0 || i >= vect->vec_size)
  441.         error("subscript out of bounds: %d",i);
  442.     sp[1] = vect->vec_data[i];
  443.     break;
  444.     case DT_STRING:
  445.     str = sp[1].v.v_string;
  446.     i = sp[0].v.v_integer;
  447.     if (i < 0 || i >= str->str_size)
  448.         error("subscript out of bounds: %d",i);
  449.     set_integer(&sp[1],str->str_data[i]);
  450.     break;
  451.     default:
  452.     badtype(1,DT_VECTOR);
  453.     break;
  454.     }
  455.     ++sp;
  456. }
  457.  
  458. /* opVSET - VSET opcode handler */
  459. static void opVSET()
  460. {
  461.     VECTOR *vect;
  462.     STRING *str;
  463.     int i;
  464.     chktype(1,DT_INTEGER);
  465.     switch (sp[2].v_type) {
  466.     case DT_VECTOR:
  467.     vect = sp[2].v.v_vector;
  468.     i = sp[1].v.v_integer;
  469.     if (i < 0 || i >= vect->vec_size)
  470.         error("subscript out of bounds: %d",i);
  471.     vect->vec_data[i] = sp[2] = *sp;
  472.     break;
  473.     case DT_STRING:
  474.     chktype(0,DT_INTEGER);
  475.     str = sp[2].v.v_string;
  476.     i = sp[1].v.v_integer;
  477.     if (i < 0 || i >= str->str_size)
  478.         error("subscript out of bounds: %d",i);
  479.     str->str_data[i] = sp[0].v.v_integer;
  480.     set_integer(&sp[2],str->str_data[i]);
  481.     break;
  482.     default:
  483.     badtype(1,DT_VECTOR);
  484.     break;
  485.     }
  486.     sp += 2;
  487. }
  488.  
  489. /* opADD - ADD opcode handler */
  490. static void opADD()
  491. {
  492.     STRING *s1,*s2,*sn;
  493.     switch (sp[1].v_type) {
  494.     case DT_INTEGER:
  495.         switch (sp[0].v_type) {
  496.         case DT_INTEGER:
  497.         sp[1].v.v_integer += sp->v.v_integer;
  498.         break;
  499.     case DT_STRING:
  500.         sn = newstring(1 + sp[0].v.v_string->str_size);
  501.         s2 = sp[0].v.v_string;
  502.         sn->str_data[0] = sp[1].v.v_integer;
  503.         memcpy(&sn->str_data[1],
  504.            s2->str_data,
  505.            s2->str_size);
  506.            set_string(&sp[1],sn);
  507.            break;
  508.     default:
  509.         break;
  510.     }
  511.     break;
  512.     case DT_STRING:
  513.     switch (sp[0].v_type) {
  514.     case DT_INTEGER:
  515.         sn = newstring(sp[1].v.v_string->str_size + 1);
  516.         s1 = sp[1].v.v_string;
  517.         memcpy(sn->str_data,
  518.            s1->str_data,
  519.            s1->str_size);
  520.            sn->str_data[s1->str_size] = sp[0].v.v_integer;
  521.         set_string(&sp[1],sn);
  522.         break;
  523.     case DT_STRING:
  524.         sn = newstring(sp[1].v.v_string->str_size
  525.              + sp[0].v.v_string->str_size);
  526.         s1 = sp[1].v.v_string;
  527.         s2 = sp[0].v.v_string;
  528.         memcpy(sn->str_data,
  529.            s1->str_data,s1->str_size);
  530.         memcpy(&sn->str_data[s1->str_size],
  531.            s2->str_data,s2->str_size);
  532.         set_string(&sp[1],sn);
  533.         break;
  534.     default:
  535.         break;
  536.     }
  537.     break;
  538.     default:
  539.     badtype(1,DT_VECTOR);
  540.     break;
  541.     }
  542.     ++sp;
  543. }
  544.  
  545. /* getwoperand - get data word */
  546. static int getwoperand()
  547. {
  548.     int b;
  549.     b = *pc++;
  550.     return ((*pc++ << 8) | b);
  551. }
  552.  
  553. /* type names */
  554. static char *tnames[] = {
  555. "NIL","CLASS","OBJECT","VECTOR","INTEGER","STRING","BYTECODE",
  556. "CODE","DICTIONARY","VAR","FILE"
  557. };
  558.  
  559. /* typename - get the name of a type */
  560. static char *typename(type)
  561.   int type;
  562. {
  563.     static char buf[20];
  564.     if (type >= _DTMIN && type <= _DTMAX)
  565.     return (tnames[type]);
  566.     sprintf(buf,"(%d)",type);
  567.     return (buf);
  568. }
  569.  
  570. /* badtype - report a bad operand type */
  571. void badtype(off,type)
  572.   int off,type;
  573. {
  574.     char tn1[20];
  575.     strcpy(tn1,typename(sp[off].v_type));
  576.     info("PC: %04x, Offset %d, Type %s, Expected %s",
  577.      pc-cbase,off,tn1,typename(type));
  578.     error("Bad argument type");
  579. }
  580.  
  581. /* stackover - report a stack overflow error */
  582. void stackover()
  583. {
  584.     error("Stack overflow");
  585. }
  586.